home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / faq-s.zip / ANSIEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-27  |  24KB  |  979 lines

  1.  
  2.       unit ansiedit;
  3.  
  4.       Interface
  5.  
  6.       uses crt,gentypes,modem,configrt,windows,gensubs,subs1,subs2;
  7.  
  8.       Function ansireedit(Var m:message;gettitle:Boolean):Boolean;
  9.  
  10.       Implementation
  11.  
  12.     Function ansireedit(Var m:message;gettitle:Boolean):Boolean;
  13.  
  14.       Var topline,curline,cx,cy,cols,scrnsize,lines,
  15.         rightmargin,savedx,savedy,topscrn:Integer;
  16.         insertmode,msgdone,ansimode:Boolean;
  17.  
  18.       Function curx:Integer;
  19.         Begin
  20.           curx:=WhereX
  21.         End;
  22.  
  23.       Function cury:Integer;
  24.         Begin
  25.           cury:=WhereY-topscrn+1
  26.         End;
  27.  
  28.       Procedure writevt52(q:lstr);
  29.         Var cnt:Integer;
  30.         Begin
  31.           If Not carrier Then exit;
  32.           For cnt:=1 To Length(q) Do sendchar(q[cnt])
  33.         End;
  34.  
  35.       Procedure moveto(x,y:Integer);
  36.         Begin
  37.           y:=y+topscrn-1;
  38.           If ansimode Then Begin
  39.             Write(direct,#27'[');
  40.             If y<>1 Then Write(direct,strr(y));
  41.             If x<>1 Then Write(direct,';',strr(x));
  42.             Write('H')
  43.           End Else Begin
  44.             GoToXY(x,y);
  45.             writevt52(#234+#234+#01+Chr(y)+Chr(x))
  46.           End
  47.         End;
  48.  
  49.       Procedure clearscr;
  50.         Begin
  51.           If ansimode
  52.           Then Write(direct,#27'[2J')
  53.           Else Begin
  54.             writevt52(#234+#234+#4);
  55.             ClrScr
  56.           End
  57.         End;
  58.  
  59.       Procedure cleareol;
  60.         Begin
  61.           If ansimode
  62.           Then Write(direct,#27'[K')
  63.           Else Begin
  64.             writevt52(#234+#234+#27);
  65.             ClrEol
  66.           End
  67.         End;
  68.  
  69.       Procedure savecsr;
  70.         Begin
  71.           If ansimode
  72.           Then Write(direct,#27'[s')
  73.           Else Begin
  74.             savedx:=curx;
  75.             savedy:=cury
  76.           End
  77.         End;
  78.  
  79.       Procedure restorecsr;
  80.         Begin
  81.           If ansimode
  82.           Then Write(direct,#27'[u')
  83.           Else moveto(savedx,savedy)
  84.         End;
  85.  
  86.       Procedure cmove(k:Char;n,dx,dy:Integer);
  87.         Var cnt:Integer;
  88.         Begin
  89.           If n<1 Then exit;
  90.           If ansimode Then Begin
  91.             Write(direct,#27'[');
  92.             If n<>1 Then Write(direct,strr(n));
  93.             Write(direct,k)
  94.           End Else
  95.             {For cnt:=1 To n Do Begin
  96.               writevt52(#27+k);}
  97.  
  98.               GoToXY(WhereX+dx,WhereY+dy);
  99.               movexy (wherex,wherey);
  100.         End;
  101.  
  102.       Procedure cup(n:Integer);
  103.         Begin
  104.           cmove('A',n,0,-1)
  105.         End;
  106.  
  107.       Procedure cdn(n:Integer);
  108.         Begin
  109.           cmove('B',n,0,1)
  110.         End;
  111.  
  112.       Procedure clf(n:Integer);
  113.         Var cnt:Integer;
  114.         Begin
  115.           cmove('D',n,-1,0)
  116.         End;
  117.  
  118.       Procedure crg(n:Integer);
  119.         Begin
  120.           cmove('C',n,1,0)
  121.         End;
  122.  
  123.       Procedure checkspaces;
  124.         Var q:^lstr;
  125.         Begin
  126.           q:=Addr(m.text[curline]);
  127.           While q^[Length(q^)]=' ' Do q^[0]:=Pred(q^[0])
  128.         End;
  129.  
  130.       Procedure checkcx;
  131.         Var n:Integer;
  132.         Begin
  133.           n:=Length(m.text[curline])+1;
  134.           If cx>n Then cx:=n
  135.         End;
  136.  
  137.       Procedure computecy;
  138.         Begin
  139.           cy:=curline-topline+1
  140.         End;
  141.  
  142.       Procedure updatecpos;
  143.         Begin
  144.           computecy;
  145.           moveto(cx,cy);
  146.           ansicolor (urec.regularcolor);
  147.         End;
  148.  
  149.       Procedure insertabove;
  150.         Var cnt:Integer;
  151.         Begin
  152.           If m.numlines=maxmessagesize Then exit;
  153.           For cnt:=m.numlines Downto curline Do m.text[cnt+1]:=m.text[cnt];
  154.           m.text[curline]:='';
  155.           m.numlines:=m.numlines+1
  156.         End;
  157.  
  158.       Procedure deletethis;
  159.         Var cnt:Integer;
  160.         Begin
  161.           If m.numlines=1 Then Begin
  162.             m.text[1]:='';
  163.             exit
  164.           End;
  165.           For cnt:=curline+1 To m.numlines Do m.text[cnt-1]:=m.text[cnt];
  166.           m.text[m.numlines]:='';
  167.           m.numlines:=m.numlines-1;
  168.           checkcx;
  169.         End;
  170.  
  171. procedure fullrefresh;
  172. var cnt,n,foxx:integer;
  173. begin
  174.   if topline<1 then topline:=1;
  175.   computecy;
  176.   clearscr;
  177.   movexy (1,1);
  178.   if asciigraphics in urec.config then begin
  179.   writeln ('╔══════════════════════════════════════════════════════════════════');
  180.   writeln ('AC════════════╗║ FAQ Version 1.02 FS-Editor    Subject');
  181.   writeln ('AC:C║║CTo:C║╚══════════════════════════════A');
  182.   writeln ('C════════════════════════════════════════════════╝');
  183.   end else begin
  184.   writeln ('+==================================================================');
  185.   writeln ('AC============+| FAQ Version 1.02 FS-Editor    Subject');
  186.   writeln ('AC:C||CTo:C|+==============================A');
  187.   writeln ('C================================================+');
  188.  end;
  189.   printxy2 (42,2,^S+m.title);
  190.   if m.anon and (urec.level<sysoplevel) then printxy2 (42,3,^S+anonymousstr);
  191.   if (not m.anon) or (urec.level>=sysoplevel) then if length(sendstr)>0 then
  192.   printxy2 (42,3,^S+sendstr) else printxy2 (42,3,^S+m.leftto);
  193.   moveto (1,1);
  194.   ansicolor (urec.regularcolor);
  195.   for cnt:=1 to lines do begin
  196.     n:=cnt+topline-1;
  197.     if n<=m.numlines then begin
  198.       write (m.text[n]);
  199.       if cnt<>lines then writeln
  200.     end
  201.   end;
  202.   updatecpos
  203. end;
  204.  
  205.       Procedure repos(dorefresh:Boolean);
  206.         Var cl,tl:Integer;
  207.         Begin
  208.           checkspaces;
  209.           cl:=curline;
  210.           tl:=topline;
  211.           If curline<1 Then curline:=1;
  212.           If curline>m.numlines Then curline:=m.numlines;
  213.           If topline>curline Then topline:=curline;
  214.           If topline+lines<curline Then topline:=curline-lines;
  215.           If topline<1 Then topline:=1;
  216.           checkcx;
  217.           computecy;
  218.           If (cl=curline) And (tl=topline) And (Not dorefresh)
  219.           Then updatecpos
  220.           Else fullrefresh
  221.         End;
  222.  
  223.       Procedure partrefresh;{ Refreshes from CY }
  224.         Var cnt,n:Integer;
  225.         Begin
  226.           If topline<1 Then repos(True) Else Begin
  227.             moveto(1,cy);
  228.             For cnt:=cy To lines Do Begin
  229.               n:=cnt+topline-1;
  230.               If n<=m.numlines Then Write(m.text[n]);
  231.               cleareol;
  232.               If cnt<>lines Then WriteLn
  233.             End;
  234.             updatecpos
  235.           End;
  236.         ansicolor (urec.regularcolor);
  237.         End;
  238.  
  239.       Procedure pageup;
  240.         Begin
  241.           checkspaces;
  242.           If curline=1 Then exit;
  243.           curline:=curline-lines+4;
  244.           topline:=topline-lines+4;
  245.           repos(True)
  246.         End;
  247.  
  248.       Procedure pagedn;
  249.         Begin
  250.           checkspaces;
  251.           If curline=m.numlines Then exit;
  252.           curline:=curline+lines-4;
  253.           topline:=topline+lines-4;
  254.           repos(True)
  255.         End;
  256.  
  257.       Procedure toggleins;
  258.         Begin
  259.           insertmode:=Not insertmode
  260.         End;
  261.  
  262.       Procedure scrolldown;
  263.         Begin
  264.           topline:=curline-lines+2;
  265.           repos(True)
  266.         End;
  267.  
  268.       Procedure scrollup;
  269.         Begin
  270.           If topline<1 Then Begin
  271.             topline:=topline+1;
  272.             moveto(1,lines);
  273.             computecy;
  274.             WriteLn
  275.           End Else Begin
  276.             topline:=curline-1;
  277.             repos(True)
  278.           End
  279.         End;
  280.  
  281.       Procedure topofmsg;
  282.         Begin
  283.           checkspaces;
  284.           cx:=1;
  285.           cy:=1;
  286.           curline:=1;
  287.           If topline=1
  288.           Then updatecpos
  289.           Else
  290.             Begin
  291.               topline:=1;
  292.               fullrefresh
  293.             End
  294.         End;
  295.  
  296.       Procedure updatetoeol;
  297.         Var cnt:Integer;
  298.         Begin
  299.           savecsr;
  300.           Write(Copy(m.text[curline],cx,255));
  301.           cleareol;
  302.           restorecsr
  303.         End;
  304.  
  305.       Procedure letterkey(k:Char);
  306.         Var l:^lstr;
  307.           w:lstr;
  308.           n,ox:Integer;
  309.           q:Char;
  310.           inserted,refr:Boolean;
  311.  
  312.         Procedure scrollwwrap;
  313.           Begin
  314.             If topline>0 Then Begin
  315.               scrollup;
  316.               exit
  317.             End;
  318.             cy:=cy-1;
  319.             moveto(Length(m.text[curline-1])+1,cy);
  320.             cleareol;
  321.             WriteLn;
  322.             Write(m.text[curline]);
  323.             topline:=topline+1;
  324.             cx:=curx
  325.           End;
  326.  
  327.         Begin
  328.           l:=Addr(m.text[curline]);
  329.           If Length(l^)>=rightmargin Then Begin
  330.             If curline=maxmessagesize Then exit;
  331.             If cx<=Length(l^) Then exit;
  332.             l^:=l^+k;
  333.             w:='';
  334.             cx:=Length(l^);
  335.             Repeat
  336.               q:=l^[cx];
  337.               If q<>' ' Then Insert(q,w,1);
  338.               cx:=cx-1
  339.             Until (q=' ') Or (cx<1);
  340.             If cx<1 Then Begin
  341.               cx:=Length(l^)-1;
  342.               w:=k
  343.             End;
  344.             l^[0]:=Chr(cx);
  345.             checkspaces;
  346.             curline:=curline+1;
  347.             If curline>m.numlines Then m.numlines:=curline;
  348.             inserted:=m.text[curline]<>'';
  349.             If inserted Then insertabove;
  350.             m.text[curline]:=w;
  351.             cy:=cy+1;
  352.             ox:=cx;
  353.             cx:=Length(w)+1;
  354.             refr:=cy>lines;
  355.             If refr
  356.             Then scrollwwrap
  357.             Else Begin
  358.               If Length(w)>0 Then Begin
  359.                 moveto(ox+1,cy-1);
  360.                 For n:=1 To Length(w) Do Write(' ')
  361.               End;
  362.               If inserted And (m.numlines>curline)
  363.               Then partrefresh
  364.               Else Begin
  365.                 moveto(1,cy);
  366.                 Write(m.text[curline]);
  367.               End
  368.             End;
  369.             exit
  370.           End;
  371.           If insertmode
  372.           Then Insert(k,l^,cx)
  373.           Else Begin
  374.             While Length(l^)<cx Do l^:=l^+' ';
  375.             l^[cx]:=k
  376.           End;
  377.           Write(k);
  378.           cx:=cx+1;
  379.           If insertmode And (cx<=Length(l^)) Then updatetoeol
  380.         End;
  381.  
  382.       Procedure Back;
  383.         Begin
  384.           If cx=1 Then Begin
  385.             If curline=1 Then exit;
  386.             checkspaces;
  387.             curline:=curline-1;
  388.             cy:=cy-1;
  389.             cx:=Length(m.text[curline])+1;
  390.             If cy<1 Then scrolldown Else updatecpos;
  391.           End Else Begin
  392.             cx:=cx-1;
  393.             clf(1)
  394.           End
  395.         End;
  396.  
  397.       Procedure fowrd;
  398.         Begin
  399.           If cx>Length(m.text[curline]) Then Begin
  400.             If curline=maxmessagesize Then exit;
  401.             checkspaces;
  402.             curline:=curline+1;
  403.             If curline>m.numlines Then m.numlines:=curline;
  404.             cy:=cy+1;
  405.             cx:=1;
  406.             If cy>lines Then scrollup Else updatecpos
  407.           End Else Begin
  408.             cx:=cx+1;
  409.             crg(1)
  410.           End
  411.         End;
  412.  
  413.       Procedure del;
  414.         Begin
  415.           If Length(m.text[curline])=0 Then Begin
  416.             deletethis;
  417.             partrefresh;
  418.             exit
  419.           End;
  420.           Delete(m.text[curline],cx,1);
  421.           If cx>Length(m.text[curline])
  422.           Then Write(' '^H)
  423.           Else updatetoeol
  424.         End;
  425.  
  426.       Procedure bkspace;
  427.         Begin
  428.           If Length(m.text[curline])=0 Then Begin
  429.             If curline=1 Then exit;
  430.             deletethis;
  431.             checkspaces;
  432.             curline:=curline-1;
  433.             cy:=cy-1;
  434.             cx:=Length(m.text[curline])+1;
  435.             If cy<1
  436.             Then scrolldown
  437.             Else partrefresh;
  438.             exit
  439.           End;
  440.           If cx=1 Then exit;
  441.           cx:=cx-1;
  442.           Write(^H);
  443.           del
  444.         End;
  445.  
  446.       Procedure beginline;
  447.         Begin
  448.           If cx=1 Then exit;
  449.           cx:=1;
  450.           updatecpos
  451.         End;
  452.  
  453.       Procedure endline;
  454.         Var dx:Integer;
  455.         Begin
  456.           dx:=Length(m.text[curline])+1;
  457.           If cx=dx Then exit;
  458.           cx:=dx;
  459.           updatecpos
  460.         End;
  461.  
  462.       Procedure upline;
  463.         Var chx:Boolean;
  464.           l:Integer;
  465.         Begin
  466.           checkspaces;
  467.           If curline=1 Then exit;
  468.           curline:=curline-1;
  469.           l:=Length(m.text[curline]);
  470.           chx:=cx>l;
  471.           If chx Then cx:=l+1;
  472.           cy:=cy-1;
  473.           If cy>0
  474.           Then If chx
  475.             Then updatecpos
  476.             Else cup(1)
  477.           Else scrolldown
  478.         End;
  479.  
  480.       Procedure downline;
  481.         Var chx:Boolean;
  482.           l:Integer;
  483.         Begin
  484.           checkspaces;
  485.           If curline=maxmessagesize Then exit;
  486.           curline:=curline+1;
  487.           If curline>m.numlines Then m.numlines:=curline;
  488.           l:=Length(m.text[curline]);
  489.           chx:=cx>l;
  490.           If chx Then cx:=l+1;
  491.           cy:=cy+1;
  492.           If cy<=lines
  493.           Then If chx
  494.             Then updatecpos
  495.             Else cdn(1)
  496.           Else scrollup
  497.         End;
  498.  
  499.       Procedure crlf;
  500.         Var k:Char;
  501.         Begin
  502.           If (Length(m.text[curline])=2) And (m.text[curline][1]='/') Then Begin
  503.             k:=UpCase(m.text[curline][2]);
  504.             Case k Of
  505.               'S' :Begin
  506.                      deletethis;
  507.                      msgdone:=True;
  508.                      ansireedit:=True;
  509.                      exit
  510.                    End;
  511.               'A' :Begin
  512.                      deletethis;
  513.                      m.numlines:=0;
  514.                      msgdone:=True;
  515.                      exit
  516.                    End
  517.             End
  518.           End;
  519.           beginline;
  520.           downline
  521.         End;
  522.  
  523.       Function conword:Boolean;
  524.         Var l:^lstr;
  525.         Begin
  526.           l:=Addr(m.text[curline]);
  527.           conword:=False;
  528.           If (cx>Length(l^)) Or (cx=0) Then exit;
  529.           conword:=True;
  530.           If cx=1 Then exit;
  531.           If (l^[cx-1]=' ') And (l^[cx]<>' ') Then exit;
  532.           conword:=False
  533.         End;
  534.  
  535.       Procedure wordleft;
  536.         Begin
  537.           Repeat
  538.             cx:=cx-1;
  539.             If cx<1 Then Begin
  540.               If curline=1 Then Begin
  541.                 cx:=1;
  542.                 repos(False);
  543.                 exit
  544.               End;
  545.               checkspaces;
  546.               curline:=curline-1;
  547.               cy:=cy-1;
  548.               cx:=Length(m.text[curline])
  549.             End;
  550.           Until conword;
  551.           If cx=0 Then cx:=1;
  552.           If cy<1
  553.           Then repos(True)
  554.           Else updatecpos
  555.         End;
  556.  
  557.       Procedure wordright;
  558.         Begin
  559.           Repeat
  560.             cx:=cx+1;
  561.             If cx>Length(m.text[curline]) Then Begin
  562.               If curline=m.numlines Then Begin
  563.                 repos(False);
  564.                 exit
  565.               End;
  566.               checkspaces;
  567.               curline:=curline+1;
  568.               cy:=cy+1;
  569.               cx:=1
  570.             End;
  571.           Until conword;
  572.           If cy>lines
  573.           Then repos(True)
  574.           Else updatecpos
  575.         End;
  576.  
  577.       Procedure worddel;
  578.         Var l:^lstr;
  579.           b:Byte;
  580.           s,n:Integer;
  581.         Begin
  582.           l:=Addr(m.text[curline]);
  583.           b:=Length(l^);
  584.           If cx>b Then exit;
  585.           s:=cx;
  586.           Repeat
  587.             cx:=cx+1
  588.           Until conword Or (cx>b);
  589.           n:=cx-s;
  590.           Delete(l^,s,n);
  591.           cx:=s;
  592.           updatetoeol
  593.         End;
  594.  
  595.       Procedure deleteline;
  596.         Begin
  597.           deletethis;
  598.           partrefresh
  599.         End;
  600.  
  601.       Procedure insertline;
  602.         Begin
  603.           If m.numlines>=maxmessagesize Then exit;
  604.           insertabove;
  605.           checkcx;
  606.           partrefresh
  607.         End;
  608.  
  609.       Procedure help;
  610.         Var k:Char;
  611.         Begin
  612.           clearscr;
  613.           if exist (textfiledir+'Edithelp.Ans') then printfile(textfiledir+'Edithelp.ANS');
  614.           Write(^B^M'Press any key...');
  615.           k:=waitforchar;
  616.           fullrefresh
  617.         End;
  618.  
  619.       Procedure breakline;
  620.         Begin
  621.           If (m.numlines>=maxmessagesize) Or (cy=lines) Or
  622.           (cx=1) Or (cx>Length(m.text[curline])) Then exit;
  623.           insertabove;
  624.           m.text[curline]:=Copy(m.text[curline+1],1,cx-1);
  625.           Delete(m.text[curline+1],1,cx-1);
  626.           partrefresh
  627.         End;
  628.  
  629.       Procedure joinlines;
  630.         Var n:Integer;
  631.         Begin
  632.           If curline=m.numlines Then exit;
  633.           If Length(m.text[curline])+Length(m.text[curline+1])>rightmargin Then exit;
  634.           m.text[curline]:=m.text[curline]+m.text[curline+1];
  635.           n:=cx;
  636.           curline:=curline+1;
  637.           deletethis;
  638.           curline:=curline-1;
  639.           cx:=n;
  640.           partrefresh
  641.         End;
  642.  
  643.       Procedure userescape;
  644.         Var k:Char;
  645.         Begin
  646.           Repeat
  647.             k:=waitforchar;
  648.             Case k Of
  649.               'A' :upline;
  650.               'B' :downline;
  651.               'C' :fowrd;
  652.               'D' :Back
  653.             End
  654.           Until (k<>'[') Or hungupon
  655.         End;
  656.  
  657.       Procedure deleteeol;
  658.         Begin
  659.           cleareol;
  660.           m.text[curline][0]:=Chr(cx-1)
  661.         End;
  662.  
  663.       Procedure tab;
  664.         Var nx,n,cnt:Integer;
  665.         Begin
  666.           nx:=((cx+8) And 248)+1;
  667.           n:=nx-cx;
  668.           If (n+Length(m.text[curline])>=cols) Or (nx>=cols) Then exit;
  669.           For cnt:=1 To n Do Insert(' ',m.text[curline],cx);
  670.           updatetoeol;
  671.           cx:=cx+n;
  672.           updatecpos
  673.         End;
  674.  
  675. procedure commands;
  676.  
  677.   function youaresure:boolean;
  678.   var q:string[1];
  679.   begin
  680.     youaresure:=false;
  681.   movexy (3,3);
  682.   write (^R'Abort [y/n]: '^U);
  683.   buflen:=1;
  684.   getstr (1);
  685.   clearbreak;
  686.   nobreak:=true;
  687.   cup (1);
  688.   if asciigraphics in urec.config then
  689.   write (^P'║               ') else
  690.   write (^P'|               ');
  691.   if length(input)=0 then begin
  692.     updatecpos;
  693.     exit;
  694.   textcolor (urec.regularcolor)
  695.   end;
  696.     youaresure:=yes;
  697.     clearbreak;
  698.     nobreak:=true
  699.   end;
  700.  
  701.   procedure savemes;
  702.   begin
  703.     msgdone:=true;
  704.     ansireedit:=true
  705.   end;
  706.  
  707.   procedure abortmes;
  708.   begin
  709.     if youaresure then begin
  710.       m.numlines:=0;
  711.       msgdone:=true
  712.     end
  713.   end;
  714.  
  715.   procedure formattext;
  716.   var ol,il,c:integer;
  717.       oln,wd,iln:lstr;
  718.       k:char;
  719.  
  720.     procedure putword;
  721.     var cnt:integer;
  722.         b:boolean;
  723.     begin
  724.       b:=true;
  725.       for cnt:=1 to length(wd) do if wd[cnt]<>' ' then b:=false;
  726.       if b then exit;
  727.       while wd[length(wd)]=' ' do wd[0]:=pred(wd[0]);
  728.       if length(wd)=0 then exit;
  729.       if length(wd)+length(oln)>rightmargin then begin
  730.         m.text[ol]:=oln;
  731.         ol:=ol+1;
  732.         while (wd[1]=' ') and (length(wd)>0) do delete (wd,1,1);
  733.         oln:=wd
  734.       end else oln:=oln+wd;
  735.       if wd[length(wd)] in ['.','?','!']
  736.         then wd:='  '
  737.         else wd:=' '
  738.     end;
  739.  
  740.   begin
  741.     il:=curline;
  742.     ol:=il;
  743.     c:=1;
  744.     oln:='';
  745.     wd:='';
  746.     iln:=m.text[il];
  747.     repeat
  748.       if length(iln)=0 then begin
  749.         putword;
  750.         m.text[ol]:=oln;
  751.         partrefresh;
  752.         checkcx;
  753.         updatecpos;
  754.         exit
  755.       end;
  756.       if c>length(iln) then begin
  757.         il:=il+1;
  758.         if il>m.numlines
  759.           then iln:=''
  760.           else begin
  761.             iln:=m.text[il];
  762.             m.text[il]:=''
  763.           end;
  764.         c:=0;
  765.         k:=' '
  766.       end else k:=iln[c];
  767.       c:=c+1;
  768.       if k=' '
  769.         then putword
  770.         else wd:=wd+k
  771.     until 0=1
  772.   end;
  773.  
  774. var cmd:string[1];
  775.     k:char;
  776. begin
  777.   clearbreak;
  778.   nobreak:=true;
  779.   movexy (3,3);
  780.   write (^R'Command: '^U);
  781.   buflen:=1;
  782.   getstr (1);
  783.   clearbreak;
  784.   nobreak:=true;
  785.   cup (1);
  786.   if asciigraphics in urec.config then
  787.   write (^P'║           ') else
  788.   write (^P'|           ');
  789.   if length(input)=0 then begin
  790.     updatecpos;
  791.     exit
  792.   end;
  793.   k:=upcase(input[1]);
  794.   case k of
  795.     'S':savemes;
  796.     'A':abortmes;
  797.     'F':formattext;
  798.     '?':help
  799.   end;
  800.   updatecpos;
  801. textcolor (urec.regularcolor)
  802. end;
  803.  
  804. procedure macro_in;
  805. var cmd:string[1];
  806.     k:char;
  807.     x,y,z:integer;
  808. begin
  809.   clearbreak;
  810.   nobreak:=true;
  811.   movexy(3,3);
  812.   write (^R'Macro #[1-3]: '^U);
  813.   buflen:=1;
  814.   getstr (1);
  815.   clearbreak;
  816.   nobreak:=true;
  817.   cup (1);
  818.   if asciigraphics in urec.config then
  819.   write (^P'║                ') else
  820.   write (^P'|                ');
  821.   if length(input)=0 then begin
  822.     updatecpos;
  823.     exit
  824.   end;
  825.   k:=upcase(input[1]);
  826.   case k of
  827.     '1':begin
  828.          updatecpos;
  829.          for x := 1 to length (urec.macro1) do
  830.           letterkey (urec.macro1[x]);
  831.         end;
  832.     '2':begin
  833.          updatecpos;
  834.          for y := 1 to length (urec.macro2) do
  835.           letterkey (urec.macro2[y]);
  836.         end;
  837.     '3':begin
  838.          updatecpos;
  839.          for z := 1 to length (urec.macro3) do
  840.           letterkey (urec.macro3[z]);
  841.         end;
  842.   end;
  843.  { updatecpos }
  844. textcolor (urec.regularcolor)
  845. end;
  846.  
  847. procedure processkey;
  848. var k:char;
  849. begin
  850.   clearbreak;
  851.   nobreak:=true;
  852.   k:=waitforchar;
  853.   case k of
  854.     ' '..#250:letterkey(k);
  855.     #251:begin
  856.          delay(100);
  857.          clearinput;
  858.          k:=#0;
  859.          end;
  860.     #252..#254:letterkey(k);
  861.     ' '..'~',#27:letterkey (k);
  862.             ^S:Back;
  863.             ^D:fowrd;
  864.             ^H:bkspace;
  865.             ^M:crlf;
  866.             ^V:toggleins;
  867.             ^E:upline;
  868.             ^X:downline;
  869.             ^U:help;
  870.             ^K:commands;
  871.             ^R:pageup;
  872.             ^C:pagedn;
  873.             ^G:del;
  874.             ^A:wordleft;
  875.             ^F:wordright;
  876.             ^T:worddel;
  877.             ^Q:beginline;
  878.             ^W:endline;
  879.             ^L:fullrefresh;
  880.             ^Y:deleteline;
  881.             ^N:insertline;
  882.             ^I:tab;
  883.             ^B:breakline;
  884.             ^P:deleteeol;
  885.             ^J:joinlines;
  886.             ^Z:macro_in;
  887.             #27:userescape
  888.           End
  889.         End;
  890.  
  891.       Var cnt:Integer;
  892.         mp:Boolean;
  893.       Begin
  894.         clearbreak;
  895.         nobreak:=True;
  896.         ansireedit:=False;
  897.         For cnt:=m.numlines+1 To maxmessagesize Do m.text[cnt]:='';
  898.         scrnsize:=urec.displaylen;
  899.         winds[0].y2:=scrnsize;
  900.         unsplit;
  901.         wholescreen;
  902.         GoToXY(1,25);
  903.         ClrEol;
  904.         If eightycols In urec.config
  905.         Then cols:=80
  906.         Else cols:=40;
  907.         ansimode:=ansigraphics In urec.config;
  908.         mp:=moreprompts In urec.config;
  909.         If mp Then urec.config:=urec.config-[moreprompts];
  910.         lines:=21;
  911.         topscrn:=scrnsize-lines+1;
  912.         insertmode:=False;
  913.         rightmargin:=cols-1;
  914.         msgdone:=False;
  915.         cx:=1;
  916.         curline:=1;
  917.         topline:=2-lines;
  918.         computecy;
  919.         updatecpos;
  920.         fullrefresh;
  921.         If m.numlines>0
  922.         Then fullrefresh
  923.         Else Begin
  924.           m.numlines:=1;updatecpos;
  925.         End;
  926.         Repeat
  927.           processkey
  928.         Until msgdone Or hungupon;
  929.         AnsiCls;
  930.         writeln(^B);
  931.         writeln(^B);
  932.         If mp Then urec.config:=urec.config+[moreprompts];
  933.         winds[0].y2:=25;
  934.         bottom;
  935.         bottomline;
  936.       End;
  937.  
  938.  
  939.       {$ifdef testansieditor}
  940.       {*}
  941.     {*}Procedure termmode;
  942.       {*}Var k:Char;
  943.       {*}Begin
  944.         {*}setparam(1,1200,False);
  945.         {*}WriteLn('Press ^D when connected.');
  946.         {*}Repeat
  947.           {*}If KeyPressed Then Begin
  948.             {*}Read(Kbd,k);
  949.             {*}If k=#4 Then exit;
  950.             {*}If k=#3 Then Halt;
  951.             {*}sendchar(k)
  952.           {*}End;
  953.           {*}While numchars>0 Do Write(getchar)
  954.         {*}Until 0=1
  955.       {*}End;
  956.       {*}
  957.     {*}Var m:message;
  958.       {*}cnt:Integer;
  959.     {*}Begin
  960.       {*}checkbreak:=False;
  961.       {*}urec.displaylen:=22;
  962.       {*}urec.config:=[eightycols];{ ,ansigraphics]; }
  963.       {*}If Not driverpresent Then Begin
  964.         {*}WriteLn('You fool.');
  965.         {*}Halt
  966.       {*}End;
  967.       {*}termmode;
  968.       {*}ConInptr:=Ofs(readchar);
  969.       {*}ConOutPtr:=Ofs(writechar);
  970.       {*}m.numlines:=0;
  971.       {*}For cnt:=1 To 100 Do m.text[cnt]:='Hello line '+Chr(cnt+64);
  972.       {*}WriteLn(ansireedit(m,False))
  973.       {*}
  974.       {$endif}
  975.  
  976.     End.
  977.  
  978.  
  979.